home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Periodicals / develop / develop 2 code / Secret Life of Mem. Mgr. / UHeapHandler.p < prev   
Encoding:
Text File  |  1990-01-31  |  9.0 KB  |  302 lines  |  [TEXT/MPS ]
  1. unit UHeapHandler;
  2. (* Written by Richard Clark (AppleLink, Delphi, GEnie, MCI, MouseHole: RDCLARK *)
  3. (*                                   Internet: rdclark@apple.com or rdclark@applelink.apple.com) *)
  4. (* Copyright (c) 1989 by Apple Computer, Inc. All Rights Reserved                       *)
  5.  
  6. interface
  7. {$S Main}
  8.  
  9.     uses
  10.         Types, QuickDraw, Menus, Memory, Windows, Dialogs, Fonts, Packages, ToolUtils,
  11.         UGlobals;
  12.  
  13.     const
  14.         kDontShowSelection = FALSE;
  15.         kDoShowSelection = TRUE;
  16.  
  17.         kLeaveDirtyFlags = FALSE;
  18.         kClearDirtyFlags = TRUE;
  19.  
  20.     procedure ZeroHeapInfo (var whichHeap: HeapInfo);
  21.  
  22.     procedure CopyHeapInfo (fromHeap: HeapInfo; var toHeap: HeapInfo);
  23.  
  24.     procedure UpdateHeapInfo (var whichHeap: HeapInfo; keepDirtyBlocks: Boolean);
  25.  
  26.     procedure DrawHeap (whichHeap: HeapInfo; showSelection: Boolean);
  27.     procedure DrawBlock (blockNum: integer; whichHeap: HeapInfo; showSelection: Boolean);
  28.  
  29. implementation
  30.  
  31.     procedure BlockToRect (blkNum: INTEGER; var blockRect: Rect; whichHeap: HeapInfo);
  32.    (* Given the number of a "heap info" array element, calculate the rectangle it occupies on *)
  33.    (* the screen. (The "user item" rectangle containing this one comes from the HeapInfo record) *)
  34.         var
  35.             relStart: LONGINT;
  36.  
  37.     begin
  38.         with whichHeap.blocks[blkNum] do
  39.             begin
  40.                 relStart := blkStart - ORD(MyDemoZone) - HeapBias;
  41.                 blockRect := whichHeap.heapRect;
  42.                 InsetRect(blockRect, 1, 1);
  43.                 blockRect.bottom := whichHeap.heapRect.bottom - relStart div bytesPerPixel;
  44.                 blockRect.top := whichHeap.heapRect.bottom - (relStart + blkSize) div bytesPerPixel;
  45.                 if (blockRect.top <= whichHeap.heapRect.top) then
  46.                     blockRect.top := whichHeap.heapRect.top + 1;
  47.             end;
  48.     end; (* BlockToRect *)
  49.  
  50.  
  51.     procedure InvalBlock (blockNum: integer; whichHeap: HeapInfo);
  52.    (* Invalidate the specified memory block on the screen. This is not presently used, as we forcibly  *)
  53.    (* redraw the entire heap every time something is changed.) *)
  54.         var
  55.             blockRect: Rect;
  56.  
  57.     begin
  58.         BlockToRect(blockNum, blockRect, whichHeap);
  59.         InvalRect(blockRect);
  60.     end; (* InvalBlock *)
  61.  
  62.  
  63.     procedure ZeroHeapInfo (var whichHeap: HeapInfo);
  64.    (* Initialize a Heap Info record *)
  65.         var
  66.             blkNum: integer;
  67.  
  68.     begin
  69.         with whichHeap do
  70.             begin
  71.                 numBlocks := 0;
  72.                 blocksUsed := 0;
  73.                 selectedBlock := 0;
  74.            (* we'll initialize the rest of the fields later *)
  75.                 for blkNum := 1 to MyArraySize do
  76.                     with blocks[blkNum] do
  77.                         begin
  78.                             blkType := blkFree;
  79.                             blkStart := 0;
  80.                             blkSize := 0;
  81.                             blkOldStart := 0;
  82.                             blkDirty := FALSE;
  83.                         end;
  84.             end;
  85.     end; (* ZeroHeapInfo *)
  86.  
  87.  
  88.     procedure CopyHeapInfo (fromHeap: HeapInfo; var toHeap: HeapInfo);
  89.    (* Copy the information from one heap to another, preserving the bounds rectangle and the old base addresses *)
  90.         var
  91.             count: INTEGER;
  92.             isDirty: Boolean;
  93.  
  94.     begin
  95.         toHeap.numBlocks := fromHeap.numBlocks;
  96.         toHeap.blocksUsed := fromHeap.blocksUsed;
  97.         toHeap.selectedBlock := fromHeap.selectedBlock;
  98.         toHeap.maxFreeBytes := fromHeap.maxFreeBytes;
  99.         toHeap.maxBlocks := fromHeap.maxBlocks;
  100.         toHeap.maxAvailBytes := fromHeap.maxAvailBytes;
  101.         toHeap.maxAfterCompact := fromHeap.maxAfterCompact;
  102.         toHeap.maxAfterPurge := fromHeap.maxAfterPurge;
  103. (* toHeap.heapRect is not copied *)
  104.         for count := 1 to MyArraySize do
  105.             begin
  106.            (* Mark a block dirty if it was dirty or the type changed *)
  107.                 isDirty := (fromHeap.blocks[count].blkDirty) or (toHeap.blocks[count].blkType <> fromHeap.blocks[count].blkType);
  108.                 toHeap.blocks[count].blkDirty := isDirty;
  109.                 toHeap.blocks[count].blkType := fromHeap.blocks[count].blkType;
  110.                 toHeap.blocks[count].blkSource := fromHeap.blocks[count].blkSource;
  111.                 toHeap.blocks[count].blkStart := fromHeap.blocks[count].blkStart;
  112.            (* toHeap.blocks[count].blkOldStart is not copied, so we can detect which blocks have moved *)
  113.                 toHeap.blocks[count].blkSize := fromHeap.blocks[count].blkSize;
  114.                 toHeap.blocks[count].blkSequence := fromHeap.blocks[count].blkSequence;
  115.                 toHeap.blocks[count].blkLocked := fromHeap.blocks[count].blkLocked;
  116.                 toHeap.blocks[count].blkPurgeable := fromHeap.blocks[count].blkPurgeable;
  117.             end;
  118.     end; (* MoveHeapInfo *)
  119.  
  120.  
  121.     procedure UpdateHeapInfo;
  122.    (* This scans the heap infor record, updating the statistics contained therein *)
  123.         var
  124.             blkNum: integer;
  125.             newStart: LONGINT;
  126.             oldPort: GrafPtr;
  127.  
  128.     begin
  129.       (* Update the current starting addresses of each of the relocatable blocks *)
  130.         for blkNum := 1 to MyArraySize do
  131.             with whichHeap.blocks[blkNum] do
  132.                 begin
  133.                     if (blkType = blkHandle) then
  134.                         begin
  135.                             newStart := ORD(StripAddress(Handle(blkSource)^));
  136.                             if newStart = 0 then               (* This code added to "Free" a relocatable block if it is purged *)
  137.                                 blkType := blkFree;
  138.                         end
  139.                     else if (blkType = blkPointer) then
  140.                         newStart := ORD(blkSource)
  141.                     else if (blkType = blkFree) then
  142.                         newStart := 0;
  143.                     if (blkStart <> newStart) or blkDirty then
  144.                         begin
  145.                             GetPort(oldPort);
  146.                             SetPort(MemoryDialog);
  147.                         (* invalidate the old rectangle *)
  148.                             if (blkStart = 0) or (blkStart = newStart) then
  149.                                 blkStart := blkOldStart;                                   (* Use the old address, which should still be valid *)
  150. (* InvalBlock(blkNum, whichHeap); *)
  151.                             blkOldStart := blkStart;
  152.                             blkStart := newStart;
  153. {$IFC FALSE}
  154.                             if (blkType = blkHandle) then                             (* Invalidate the new rectangle *)
  155.                                 InvalBlock(blkNum, whichHeap);
  156. {$ENDC}
  157.                             SetPort(oldPort);
  158.                             blkDirty := blkDirty and not keepDirtyBlocks;
  159.                         end;
  160.                 end;
  161.  
  162.         SetZone(MyDemoZone);
  163.         with whichHeap do
  164.             begin
  165.            (* Update the heap statistics *)
  166.                 maxFreeBytes := FreeMem;
  167.                 maxBlocks := maxFreeBytes div 1024;
  168.                 if system.EnhancedROMs then
  169.                     begin
  170.                         PurgeSpace(maxAvailBytes, maxAfterPurge);
  171.                         maxAfterCompact := MaxBlock;
  172.                     end
  173.                 else
  174.                     begin
  175.                         maxAvailBytes := -1;
  176.                         maxAfterCompact := -1;
  177.                         maxAfterPurge := -1;
  178.                     end
  179.             end;
  180.         SetZone(MyAppZone);
  181.  
  182.     end; (* UpdateHeapInfo *)
  183.  
  184.  
  185.     procedure DrawBlock (blockNum: integer; whichHeap: HeapInfo; showSelection: Boolean);
  186.   (* Given an array index, draw the specified block on the screen *)
  187.         var
  188.             blockRect: Rect;
  189.             blockPat: Pattern;
  190.             bnString: Str255;
  191.             oldFace: Style;
  192.             oldFont, oldSize: INTEGER;
  193.             labelString, aString: Str255;
  194.             whiteOutRect: Rect;
  195.  
  196.     begin
  197.         blockToRect(blockNum, blockRect, whichHeap);
  198.         with whichHeap.blocks[blockNum] do
  199.             if blkType = blkHandle then
  200.                 begin
  201.                     GetIndPattern(blockPat, sysPatListID, 22); { 25% Gray }
  202.                     ForeColor(greenColor);
  203.                 end
  204.             else if blkType = blkPointer then
  205.                 begin
  206.                     GetIndPattern(blockPat, sysPatListID, 28); { Diagonal Lines }
  207.                     ForeColor(redColor);
  208.                 end
  209.             else if blkType = blkMaster then
  210.                 begin
  211.                     GetIndPattern(blockPat, sysPatListID, 33); { Up Arrows }
  212.                     ForeColor(magentaColor);
  213.                 end;
  214.         FillRect(blockRect, blockPat);
  215.         FrameRect(blockRect);
  216.  
  217.      (* Now, draw the block's assigned number *)
  218.         oldFont := thePort^.txFont;
  219.         oldSize := thePort^.txSize;
  220.         oldface := thePort^.txFace;
  221.  
  222.         ForeColor(blackColor);
  223.         PenMode(patCopy);
  224.         MoveTo(blockRect.left + 2, blockRect.bottom - 3);
  225.         TextFont(geneva);
  226.         TextFace([bold]);
  227.         TextSize(9);
  228.         NumToString(whichHeap.blocks[blockNum].blkSequence, bnString);
  229.         DrawString(bnString);
  230.         TextFace([]);
  231.         labelString := '';
  232.         if whichHeap.blocks[blockNum].blkLocked = TRUE then
  233.             begin
  234.                 GetIndString(aString, 1000, 1);
  235.                 Insert(aString, labelString, length(labelString) + 1);
  236.             end;
  237.         if whichHeap.blocks[blockNum].blkPurgeable = TRUE then
  238.             begin
  239.                 GetIndString(aString, 1000, 2);
  240.                 Insert(aString, labelString, length(labelString) + 1);
  241.             end;
  242.         if (labelString <> '') then
  243.             begin
  244.                 SetRect(whiteOutRect, 0, -9, StringWidth(labelString) + 1, 2);
  245.                 with thePort^.pnLoc do
  246.                     OffsetRect(whiteOutRect, h, v);
  247.                 EraseRect(whiteOutRect);
  248.                 DrawString(labelString);
  249.             end;
  250.  
  251.         TextFont(oldFont);
  252.         TextSize(oldSize);
  253.         TextFace(oldFace);
  254.  
  255.         if (blockNum <> 0) and (whichHeap.selectedBlock = blockNum) and showSelection then
  256.             begin
  257.                 InsetRect(blockRect, 1, 1);
  258.                 InvertRect(blockRect);
  259.             end;
  260.     end; (* DrawBlock *)
  261.  
  262.  
  263.     procedure DrawHeap (whichHeap: HeapInfo; showSelection: Boolean);
  264.    (* This draws the contents of the specified heap zone on the screen *)
  265.  
  266.         var
  267.             v, dv: integer;
  268.             count: integer;
  269.             blkNum: integer;
  270.  
  271.     begin
  272.  (* Frame the display area *)
  273.         PenPat(black);
  274.         PenSize(1, 1);
  275.         EraseRect(whichHeap.heapRect);     (* erase before framing, since EraseRect will destroy the frame also *)
  276.         FrameRect(whichHeap.heapRect);
  277.  
  278.      (* draw the cross-bars *)
  279.         PenPat(gray);
  280.         with whichHeap.heapRect do
  281.             begin
  282.                 dv := (bottom - top) div MyHeapSize;
  283.                 v := top;
  284.                 for count := 1 to MyHeapSize - 1 do
  285.                     begin
  286.                         v := v + dv;
  287.                         MoveTo(left + 1, v);
  288.                         LineTo(right - 2, v);
  289.                     end;
  290.             end;
  291.         PenPat(black);
  292.  
  293.      (* Now, draw each of the blocks in the heap *)
  294.         if whichHeap.blocksUsed > 0 then
  295.             for blkNum := 1 to MyArraySize do
  296.                 with whichHeap.blocks[blkNum] do
  297.                     if (blkType <> blkFree) then
  298.                         DrawBlock(blkNum, whichHeap, showSelection);
  299.         ForeColor(blackColor);
  300.     end; (* DrawHeap *)
  301.  
  302. end.